{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit Pad;

interface

uses
  SysUtils, Classes, MiscUtils;

type
  TPadObject = class;
  TPadObjectClass = class of TPadObject;
  TPadObjectList = TGenericObjectList<TPadObject>;

  TPad = class
  private
    FObjects: TPadObjectList;
    FModifyLockCount: Integer;
    FVersion: Int64;
    FVersionInBeginModify: Int64;
    FOnChange: TNotifyEvent;
    FOnEndModify: TNotifyEvent;
    function GetObjectCount: Integer;
    function GetObjects(Index: Integer): TPadObject;
    procedure CheckObjectIndex(Index: Integer);
    procedure Changed;
    function GetText: UnicodeString;
    function GetSimpleText: UnicodeString;
    procedure SetSimpleText(const Value: UnicodeString);
    procedure DoChange;
    procedure DoEndModify;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure BeginModify;
    procedure EndModify;
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromStream(Stream: TStream);
    procedure Assign(Source: TPad);
    function Clone: TPad;
    function IsEmpty: Boolean;
    procedure AddObject(Obj: TPadObject);
    procedure RemoveObject(Obj: TPadObject);
    procedure DeleteObject(Index: Integer);
    procedure InsertObject(Obj: TPadObject; Index: Integer);
    function ReplaceString(const OldString, NewString: String): Integer;
    procedure AddText(const s: UnicodeString);
    function GetCharCount: Integer;
    procedure JoinTextObjects(Index: Integer);
    procedure RemoveObjectAndJoinText(Obj: TPadObject);

    property ObjectCount: Integer read GetObjectCount;
    property Objects[Index: Integer]: TPadObject read GetObjects;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnEndModify: TNotifyEvent read FOnEndModify write FOnEndModify;
    property SimpleText: UnicodeString read GetSimpleText write SetSimpleText;
    property Text: UnicodeString read GetText;
    property Version: Int64 read FVersion;
  end;
  TPadList = TGenericObjectList<TPad>;

  TPadObject = class
  private
    FPad: TPad;
    function GetIndex: Integer;
  protected
    procedure Changed;
  public
    constructor Create; virtual;
    procedure Assign(Source: TPadObject); virtual;
    function Clone: TPadObject;
    function GetCharCount: Integer; virtual; abstract;
    procedure SaveToStream(Stream: TStream); virtual; abstract;
    procedure LoadFromStream(Stream: TStream); virtual; abstract;

    property Index: Integer read GetIndex;
    property Pad: TPad read FPad;
  end;

  TTextPadObject = class(TPadObject)
  private
    FText: UnicodeString;
    procedure SetText(const Value: UnicodeString);
  public
    function GetCharCount: Integer; override;
    procedure SaveToStream(Stream: TStream); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure Assign(Source: TPadObject); override;

    property Text: UnicodeString read FText write SetText;
  end;

  TLineFeedPadObject = class(TPadObject)
  public
    function GetCharCount: Integer; override;
    procedure SaveToStream(Stream: TStream); override;
    procedure LoadFromStream(Stream: TStream); override;
  end;

  TGraphicPadObject = class(TPadObject)
  private
    FImageFormat: String;
    FImageData: String;
    FSourceFormat: String;
    FSourceData: String;
    FCachedImage: TObject;
    procedure SetCachedImage(Value: TObject);
    procedure SetImageData(const Value: String);
    procedure SetImageFormat(const Value: String);
    procedure SetSourceData(const Value: String);
    procedure SetSourceFormat(const Value: String);
    procedure InvalidateCachedImage;
  public
    destructor Destroy; override;
    function GetCharCount: Integer; override;
    procedure SaveToStream(Stream: TStream); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure Assign(Source: TPadObject); override;

    property CachedImage: TObject read FCachedImage write SetCachedImage;
    property ImageData: String read FImageData write SetImageData;
    property ImageFormat: String read FImageFormat write SetImageFormat;
    property SourceData: String read FSourceData write SetSourceData;
    property SourceFormat: String read FSourceFormat write SetSourceFormat;
  end;

  TPadGroup = class
  private
    FPads: TPadList;
    procedure CheckPadIndex(Index: Integer);
    function GetCount: Integer;
    function GetPads(Index: Integer): TPad;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure Add(Pad: TPad);
    function ReplaceString(const OldString, NewString: String): Integer;
    procedure Assign(Source: TPadGroup);

    property Count: Integer read GetCount;
    property Pads[Index: Integer]: TPad read GetPads; default;
  end;

implementation

function PadObjectClassToStreamType(Cls: TPadObjectClass): Byte;
begin
  if Cls = TTextPadObject then
    Result := 1
  else if Cls = TLineFeedPadObject then
    Result := 2
  else if Cls = TGraphicPadObject then
    Result := 3
  else
    Assert( FALSE );
end;

function StreamTypeToPadObjectClass(StreamType: Byte): TPadObjectClass;
begin
  case StreamType of
    1: Result := TTextPadObject;
    2: Result := TLineFeedPadObject;
    3: Result := TGraphicPadObject;
    else
      raise Exception.Create('StreamTypeToPadObjectClass: unknown StreamType.');
  end;
end;

{ TPad }

procedure TPad.BeginModify;
begin
  if FModifyLockCount = 0 then
    FVersionInBeginModify := FVersion;
  Inc(FModifyLockCount);
end;

procedure TPad.Changed;
begin
  Inc(FVersion);
  DoChange;
  if FModifyLockCount = 0 then
    DoEndModify;
end;

procedure TPad.CheckObjectIndex(Index: Integer);
begin
  Assert( Index >= 0 );
  Assert( Index < ObjectCount );
end;

procedure TPad.Clear;
begin
  if not IsEmpty then
  begin
    FObjects.Clear;
    Changed;
  end;
end;

constructor TPad.Create;
begin
  inherited;
  FVersion := 1;
  FObjects := TPadObjectList.Create;
end;

destructor TPad.Destroy;
begin
  FreeAndNil(FObjects);
  inherited;
end;

procedure TPad.EndModify;
begin
  Assert( FModifyLockCount > 0 );
  Dec(FModifyLockCount);
  if (FModifyLockCount = 0) and (FVersion <> FVersionInBeginModify) then
    DoEndModify;
end;

function TPad.GetObjectCount: Integer;
begin
  Result := FObjects.Count;
end;

function TPad.GetObjects(Index: Integer): TPadObject;
begin
  CheckObjectIndex(Index);
  Result := FObjects[Index];
end;

procedure TPad.LoadFromStream(Stream: TStream);
var
  i: Integer;
  Obj: TPadObject;
begin
  BeginModify;
  try
    Clear;
    for i := 0 to ReadStreamInteger(Stream)-1 do
    begin
      Obj := StreamTypeToPadObjectClass(Stream.ReadByte).Create;
      AddObject(Obj);
      Obj.LoadFromStream(Stream);
    end;
  finally
    EndModify;
  end;
end;

procedure TPad.SaveToStream(Stream: TStream);
var
  Obj: TPadObject;
begin
  WriteStreamInteger(Stream, ObjectCount);
  for Obj in FObjects do
  begin
    Stream.WriteByte(PadObjectClassToStreamType(TPadObjectClass(Obj.ClassType)));
    Obj.SaveToStream(Stream);
  end;
end;

procedure TPad.Assign(Source: TPad);
var
  Obj: TPadObject;
begin
  BeginModify;
  try
    Clear;
    for Obj in Source.FObjects do
      AddObject(Obj.Clone);
  finally
    EndModify;
  end;
end;

function TPad.Clone: TPad;
begin
  Result := TPad.Create;
  try
    Result.Assign(Self);
  except
    Result.Free;
    raise;
  end;
end;

function TPad.GetText: UnicodeString;
var
  i: Integer;
  Obj: TPadObject;
begin
  Result := '';
  for i := 0 to ObjectCount-1 do
  begin
    Obj := Objects[i];
    if Obj is TTextPadObject then
      Result := Result + TTextPadObject(Obj).Text
    else
      if (i = 0) or (FObjects[i-1].ClassType <> Obj.ClassType) then
        if Obj is TLineFeedPadObject then
          Result := Result + ' '
        else
          Result := Result + '...';
  end;
end;

function TPad.IsEmpty: Boolean;
begin
  Result := ObjectCount = 0;
end;

procedure TPad.AddObject(Obj: TPadObject);
begin
  InsertObject(Obj, ObjectCount);
end;

procedure TPad.DeleteObject(Index: Integer);
begin
  Assert( (Index >= 0) and (Index < FObjects.Count) );
  FObjects.Delete(Index);
  Changed;
end;

procedure TPad.RemoveObject(Obj: TPadObject);
var
  Index: Integer;
begin
  Index := FObjects.IndexOf(Obj);
  if Index <> -1 then
    DeleteObject(Index);
end;

procedure TPad.JoinTextObjects(Index: Integer);
begin
  if (Index >= 0) and (Index < FObjects.Count-1) and
    (FObjects[Index] is TTextPadObject) and (FObjects[Index+1] is TTextPadObject) then
  begin
    BeginModify;
    try
      TTextPadObject(FObjects[Index]).Text := TTextPadObject(FObjects[Index]).Text + TTextPadObject(FObjects[Index+1]).Text;
      DeleteObject(Index+1);
    finally
      EndModify;
    end;
  end;
end;

procedure TPad.RemoveObjectAndJoinText(Obj: TPadObject);
var
  Index: Integer;
begin
  Index := FObjects.IndexOf(Obj);
  if Index <> -1 then
  begin
    BeginModify;
    try
      DeleteObject(Index);
      JoinTextObjects(Index-1);
    finally
      EndModify;
    end;
  end;
end;

procedure TPad.InsertObject(Obj: TPadObject; Index: Integer);
begin
  Assert( Obj.FPad = nil );
  try
    Obj.FPad := Self;
    FObjects.Insert(Index, Obj);
  except
    Obj.Free;
    raise;
  end;
  Changed;
end;

function TPad.GetCharCount: Integer;
var
  o: TPadObject;
begin
  Result := 0;
  for o in FObjects do
    Inc(Result, o.GetCharCount);
end;

function TPad.GetSimpleText: UnicodeString;
var
  Obj: TPadObject;
  Prefix: UnicodeString;
begin
  Result := '';
  Prefix := '';
  for Obj in FObjects do
  begin
    if Obj is TTextPadObject then
    begin
      Result := Result + Prefix + TTextPadObject(Obj).FText;
      Prefix := '';
    end
    else if Obj is TLineFeedPadObject then
    begin
      Result := Result + LineEnding;
      Prefix := '';
    end
    else
      Prefix := ' ';
  end;
end;

procedure TPad.SetSimpleText(const Value: UnicodeString);
var
  s: UnicodeString;
  k, n: Integer;
  c: UnicodeChar;

  procedure Add(const t: UnicodeString);
  var
    Obj: TTextPadObject;
  begin
    if t <> '' then
    begin
      Obj := TTextPadObject.Create;
      try
        Obj.Text := t;
      except
        Obj.Free;
        raise;
      end;
      AddObject(Obj);
    end;
  end;

begin
  BeginModify;
  try
    Clear;
    SetLength(s, Length(Value));
    k := 0;
    for c in Value do
    begin
      if (c >= ' ') or (c = #10) then
      begin
        Inc(k);
        s[k] := c;
      end;
    end;
    SetLength(s, k);

    if s <> '' then
    begin
      k := 1;
      repeat
        n := UnicodePosEx(#10, s, k);
        if n > 0 then
        begin
          Add(Copy(s, k, n-k));
          AddObject(TLineFeedPadObject.Create);
          k := n+1;
        end;
      until n = 0;
      Add(Copy(s, k, Length(s)-k+1));
    end;
  finally
    EndModify;
  end;
end;

procedure TPad.DoChange;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TPad.DoEndModify;
begin
  if Assigned(FOnEndModify) then
    FOnEndModify(Self);
end;

function TPad.ReplaceString(const OldString, NewString: String): Integer;
var
  i, j, ReplaceCount: Integer;
  Obj: TPadObject;
  sl: TStringList;
  TextObj, NewTextObj: TTextPadObject;
  Res: String;
begin
  BeginModify;
  try
    Result := 0;
    i := 0;
    sl := TStringList.Create;
    try
      while i < ObjectCount do
      begin
        Obj := FObjects[i];
        if Obj is TTextPadObject then
        begin
          TextObj := TTextPadObject(Obj);
          Res := ReplacePattern(UTF8Encode(TextObj.Text), OldString, NewString, ReplaceCount);
          if ReplaceCount > 0 then
          begin
            Inc(Result, ReplaceCount);
            sl.Text := Res;
            if (sl.Count = 1) and (sl[0] <> '') then
            begin
              TextObj.Text := UTF8Decode(sl[0]);
              Inc(i);
            end
            else
            begin
              DeleteObject(i);
              for j := 0 to sl.Count-1 do
              begin
                if j > 0 then
                begin
                  InsertObject(TLineFeedPadObject.Create, i);
                  Inc(i);
                end;
                if sl[j] <> '' then
                begin
                  NewTextObj := TTextPadObject.Create;
                  try
                    NewTextObj.Text := UTF8Decode(sl[j]);
                  except
                    NewTextObj.Free;
                    raise;
                  end;
                  InsertObject(NewTextObj, i);
                  Inc(i);
                end;
              end;
            end;
          end
          else
            Inc(i);
        end
        else
          Inc(i);
      end;
    finally
      sl.Free;
    end;
  finally
    EndModify;
  end;
end;

procedure TPad.AddText(const s: UnicodeString);
var
  TextObj: TTextPadObject;
begin
  BeginModify;
  try
    if not IsEmpty and (FObjects.Last is TTextPadObject) then
      TTextPadObject(FObjects.Last).Text := TTextPadObject(FObjects.Last).Text + s
    else
    begin
      TextObj := TTextPadObject.Create;
      try
        TextObj.Text := s;
      except
        TextObj.Free;
        raise;
      end;
      AddObject(TextObj);
    end
  finally
    EndModify;
  end;
end;

{ TPadObject }

procedure TPadObject.Assign(Source: TPadObject);
begin
  Assert( ClassType = Source.ClassType );
end;

procedure TPadObject.Changed;
begin
  if FPad <> nil then
    FPad.Changed;
end;

function TPadObject.Clone: TPadObject;
begin
  Result := TPadObjectClass(ClassType).Create;
  try
    Result.Assign(Self);
  except
    Result.Free;
    raise;
  end;
end;

constructor TPadObject.Create;
begin
  inherited;
  { nothing else to do }
end;

function TPadObject.GetIndex: Integer;
begin
  Assert( FPad <> nil );
  Result := FPad.FObjects.IndexOf(Self);
end;

{ TTextPadObject }

function TTextPadObject.GetCharCount: Integer;
begin
  Result := Length(FText);
end;

procedure TTextPadObject.SaveToStream(Stream: TStream);
begin
  WriteStreamSizedString(Stream, UTF8Encode(FText));
end;

procedure TTextPadObject.LoadFromStream(Stream: TStream);
begin
  Text := UTF8Decode(ReadStreamSizedString(Stream));
end;

procedure TTextPadObject.Assign(Source: TPadObject);
begin
  inherited;
  Text := (Source as TTextPadObject).Text;
end;

procedure TTextPadObject.SetText(const Value: UnicodeString);
begin
  if FText <> Value then
  begin
    FText := Value;
    Changed;
  end;
end;

{ TLineFeedPadObject }

function TLineFeedPadObject.GetCharCount: Integer;
begin
  Result := 1;
end;

procedure TLineFeedPadObject.SaveToStream(Stream: TStream);
begin
  { do nothing }
end;

procedure TLineFeedPadObject.LoadFromStream(Stream: TStream);
begin
  { do nothing }
end;

{ TGraphicPadObject }

function TGraphicPadObject.GetCharCount: Integer;
begin
  Result := 1;
end;

procedure TGraphicPadObject.SaveToStream(Stream: TStream);
begin
  WriteStreamSizedString(Stream, FImageFormat);
  WriteStreamSizedString(Stream, FImageData);
  WriteStreamSizedString(Stream, FSourceFormat);
  WriteStreamSizedString(Stream, FSourceData);
end;

procedure TGraphicPadObject.LoadFromStream(Stream: TStream);
begin
  InvalidateCachedImage;

  FImageFormat := ReadStreamSizedString(Stream);
  FImageData := ReadStreamSizedString(Stream);
  FSourceFormat := ReadStreamSizedString(Stream);
  FSourceData := ReadStreamSizedString(Stream);

  Changed;
end;

procedure TGraphicPadObject.Assign(Source: TPadObject);
var
  g: TGraphicPadObject;
begin
  inherited;
  g := Source as TGraphicPadObject;
  InvalidateCachedImage;

  FImageFormat := g.FImageFormat;
  FImageData := g.FImageData;
  FSourceFormat := g.FSourceFormat;
  FSourceData := g.FSourceData;

  Changed;
end;

destructor TGraphicPadObject.Destroy;
begin
  FreeAndNil(FCachedImage);
  inherited;
end;

procedure TGraphicPadObject.SetCachedImage(Value: TObject);
begin
  if FCachedImage <> Value then
  begin
    FreeAndNil(FCachedImage);
    FCachedImage := Value;
  end;
end;

procedure TGraphicPadObject.SetImageData(const Value: String);
begin
  if FImageData <> Value then
  begin
    InvalidateCachedImage;
    FImageData := Value;
    Changed;
  end;
end;

procedure TGraphicPadObject.SetImageFormat(const Value: String);
begin
  if FImageFormat <> Value then
  begin
    InvalidateCachedImage;
    FImageFormat := Value;
    Changed;
  end;
end;

procedure TGraphicPadObject.InvalidateCachedImage;
begin
  FreeAndNil(FCachedImage);
end;

procedure TGraphicPadObject.SetSourceData(const Value: String);
begin
  if FSourceData <> Value then
  begin
    FSourceData := Value;
    Changed;
  end;
end;

procedure TGraphicPadObject.SetSourceFormat(const Value: String);
begin
  if FSourceFormat <> Value then
  begin
    FSourceFormat := Value;
    Changed;
  end;
end;

{ TPadGroup }

procedure TPadGroup.Add(Pad: TPad);
begin
  FPads.AddSafely(Pad);
end;

procedure TPadGroup.Assign(Source: TPadGroup);
var
  Pad: TPad;
begin
  Clear;
  for Pad in Source.FPads do
    Add(Pad.Clone);
end;

procedure TPadGroup.CheckPadIndex(Index: Integer);
begin
  Assert( Index >= 0 );
  Assert( Index < Count );
end;

procedure TPadGroup.Clear;
begin
  FPads.Clear;
end;

constructor TPadGroup.Create;
begin
  inherited;
  FPads := TPadList.Create;
end;

destructor TPadGroup.Destroy;
begin
  FreeAndNil(FPads);
  inherited;
end;

function TPadGroup.GetCount: Integer;
begin
  Result := FPads.Count;
end;

function TPadGroup.GetPads(Index: Integer): TPad;
begin
  CheckPadIndex(Index);
  Result := FPads[Index];
end;

function TPadGroup.ReplaceString(const OldString, NewString: String): Integer;
var
  Pad: TPad;
begin
  Result := 0;
  for Pad in FPads do
    Inc(Result, Pad.ReplaceString(OldString, NewString));
end;

end.
